home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DELPHI32
/
GRAPHICS
/
IMGLIB95
/
UIMAGE.PA_
/
UIMAGE.PA
Wrap
Text File
|
1996-03-31
|
34KB
|
1,016 lines
{
Written by Jan Dekkers and Kevin Adams (c) 1995, 1996. If you are a non
registered client, you may use or alter this demo only for evaluation
purposes.
Copyright by SkyLine Tools. All rights reserved.
Part of Imagelib VCL/DLL Library.
}
unit Uimage;
{Includes settings to compile in either 16 or 32 bit}
{$I DEFILIB.INC}
interface
uses
{$IFDEF DEL32}
Windows,
{$ELSE}
WinTypes,
WinProcs,
{$ENDIF}
DLL95V1, {ImageLib Dll interface and misc. functions}
SysUtils,
Messages,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
FileCtrl,
Spin,
Buttons,
ExtCtrls,
Gauges,
printers,
Menus,
Uabout,
UFullscr, {Full screen display unit}
U_p_size, {Printer size unit}
TMultiP, Preview; {PMultiImage VCL component}
type
TViewImageForm = class(TForm)
DriveComboBox1 : TDriveComboBox;
DirectoryListBox1 : TDirectoryListBox;
FileListBox1 : TFileListBox;
SaveDialog1 : TSaveDialog;
SaveButton : TBitBtn;
QualitySpin : TSpinEdit;
Smoothspin : TSpinEdit;
QualityLabel : TLabel;
SmoothLabel : TLabel;
GroupBox1 : TGroupBox;
res4 : TRadioButton;
res24 : TRadioButton;
res8 : TRadioButton;
MainMenu1 : TMainMenu;
N1 : TMenuItem;
O1 : TMenuItem;
N2 : TMenuItem;
E1 : TMenuItem;
A1 : TMenuItem;
OpenDialog1 : TOpenDialog;
N4 : TMenuItem;
Print1 : TMenuItem;
PrintSetup1 : TMenuItem;
PrinterSetupDialog1: TPrinterSetupDialog;
PrintDialog1 : TPrintDialog;
Label9 : TLabel;
Label10 : TLabel;
Label11 : TLabel;
Label12 : TLabel;
Label13 : TLabel;
Label14 : TLabel;
Label15 : TLabel;
Edit1 : TEdit;
Edit2 : TEdit;
Edit3 : TEdit;
Edit4 : TEdit;
Edit5 : TEdit;
Edit6 : TEdit;
Edit7 : TEdit;
GetInfoChecked : TCheckBox;
Label8 : TLabel;
Edit8 : TEdit;
BitBtn1 : TBitBtn;
Edit9 : TMenuItem;
Cut1 : TMenuItem;
Copy1 : TMenuItem;
Paste1 : TMenuItem;
ScrollBar1 : TScrollBar;
N5 : TMenuItem;
CreateMessage1 : TMenuItem;
CheckBox2 : TCheckBox;
BitBtn2 : TBitBtn;
BitBtn3 : TBitBtn;
BitBtn4 : TBitBtn;
CreateCreditMessage1: TMenuItem;
BitBtn5 : TBitBtn;
Scanning: TBitBtn;
GroupBox2 : TGroupBox;
SaveRes4 : TRadioButton;
SaveRes24 : TRadioButton;
SaveRes8 : TRadioButton;
CheckBox3 : TCheckBox;
SaveResJpegGray : TRadioButton;
SaveRes4System : TRadioButton;
res4System : TRadioButton;
CheckBox4 : TCheckBox;
resAuto : TRadioButton;
SaveResAuto : TRadioButton;
ScrollBox1 : TScrollBox;
MultiImage1 : TPMultiImage;
Edit10 : TEdit;
Label1 : TLabel;
BitBtn7 : TBitBtn;
Button3: TButton;
Button2: TButton;
Button4: TButton;
Label2: TLabel;
CheckBox1: TCheckBox;
N6: TMenuItem;
Gauge1: TGauge;
TiffCombo: TComboBox;
Label3: TLabel;
N3: TMenuItem;
Scan1: TMenuItem;
SelectScanner1: TMenuItem;
N7: TMenuItem;
LoadresourcefromDelphiExe1: TMenuItem;
res1: TRadioButton;
ThumbPreview1: TThumbPreview;
OpenUsingThumbnails1: TMenuItem;
procedure DriveComboBox1Change(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
procedure SstretchOnOff(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure resClick(Sender: TObject);
procedure SaveButtonClick(Sender: TObject);
procedure MultiImage1Click(Sender: TObject);
procedure E1Click(Sender: TObject);
procedure O1Click(Sender: TObject);
procedure A1Click(Sender: TObject);
procedure Print1Click(Sender: TObject);
procedure PrintSetup1Click(Sender: TObject);
procedure GetInfoCheckedClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Cut1Click(Sender: TObject);
procedure Copy1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure SmoothspinChange(Sender: TObject);
procedure QualitySpinChange(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure SaveResClick(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure MultiImage1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MultiImage1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure MultiImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SstretchRatioOnOff(Sender: TObject);
procedure TiffComboChange(Sender: TObject);
procedure Scan1Click(Sender: TObject);
procedure SelectScanner1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure OpenUsingThumbnails1Click(Sender: TObject);
private
{ Private declarations }
oldsavefiles : TstringList;
oldreadfiles : TstringList;
pointStart : TPoint;
pointEnd : TPoint;
bRightDown : Boolean;
procedure DrawRubberband;
procedure DisPlayInfo(dis : boolean);
Procedure Trigger(Sender : TObject; Var Done : Boolean);
public
{ Public declarations }
end;
var
ViewImageForm: TViewImageForm;
implementation
{$R *.DFM}
{$IFDEF DEL32}
{$R BLIT32.RES} {This contains a 256 color bitmap}
{$ELSE}
{$R BLIT16.RES} {This contains a 256 color bitmap}
{$ENDIF}
{---------------------------------------------------------------------}
{Changed in version 2.21 from a procedure to a function with cdecl.
To cancel return a 0 else return a 1}
Function ImageLibCallBack(i : integer) : integer; cdecl; export;
{Callback function from the dll, CDECL and EXPORT ARE REQUIRED}
begin
if Application.Terminated then begin
{User wants to terminate the program. Pass a 0 to the dll}
Result:=0;
end else begin
{Be nice to others <g>}
Application.ProcessMessages;
{process a Gauge}
if ViewImageForm <> Nil then
ViewImageForm.Gauge1.Progress:=i;
{tell the dll that everything is OK}
Result:=1;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.DriveComboBox1Change(Sender: TObject);
{update the drive of DirectoryListBox1 with the drive of DriveComboBox1}
begin
DirectoryListBox1.Drive := DriveComboBox1.Drive;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.DisPlayInfo(dis : boolean);
begin
{If scrolling message then show the speed scroll bar}
if (MultiImage1.BFileType = 'SCM') or (MultiImage1.BFileType = 'CMS') then begin
{Show it}
ScrollBar1.Visible:=true;
{set the speed/position}
ScrollBar1.Position:=MultiImage1.MsgSpeed;
end else
ScrollBar1.Visible:=False;
if dis then begin
{display the image info}
Edit1.Text:=IntToStr(MultiImage1.Bwidth);
Edit2.Text:=IntToStr(MultiImage1.BHeight);
Edit3.Text:=IntToStr(MultiImage1.Bbitspixel);
Edit4.Text:=IntToStr(MultiImage1.Bplanes);
Edit5.Text:=IntToStr(MultiImage1.Bnumcolors);
Edit6.Text:=MultiImage1.BFileType;
Edit7.Text:=MultiImage1.Bcompression;
Edit8.Text:=IntToStr(MultiImage1.BSize);
end else begin
{set the image info to ''}
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
Edit4.Text:='';
Edit5.Text:='';
Edit6.Text:='';
Edit7.Text:='';
Edit8.Text:='';
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.DirectoryListBox1Change(Sender: TObject);
{update the directory of FileListBox1 with the directory of FileListBox1}
begin
FileListBox1.Directory := DirectoryListBox1.Directory;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.FileListBox1Change(Sender: TObject);
{Display the image of the FileListBox1.filename}
begin
{Reset image sizes}
MultiImage1.Height:=239;
MultiImage1.Width:=334;
{set hourglass cursor}
screen.cursor:=crHourGlass;
{delete the old image}
MultiImage1.imagename:='';
{display an image using the vcl}
MultiImage1.imagename:=FileListBox1.filename;
{Request fileinfo from the DLL}
if GetInfoChecked.Checked then
DisplayInfo(true) else DisplayInfo(false);
{Reset the gauge}
Gauge1.Progress:=0;
{add filename to the history list of the open dialog}
oldreadfiles.add(FileListBox1.filename);
{copy the stringlist to the historylist}
OpenDialog1.historylist:=oldreadfiles;
{set default cursor}
screen.cursor:=crDefault;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SstretchOnOff(Sender: TObject);
{set stretch mode}
begin
MultiImage1.Stretch:=CheckBox3.Checked;
CheckBox1.Checked:=False;
if (MultiImage1.Stretch) or (MultiImage1.StretchRatio) then begin
{Reset image sizes}
MultiImage1.AutoSize:=False;
MultiImage1.Height:=239;
MultiImage1.Width:=334;
ScrollBox1.ScrollInView(MultiImage1);
Button2.Enabled:=True;
Button3.Enabled:=True;
Button4.Enabled:=True;
end else begin
MultiImage1.AutoSize:=True;
Button2.Enabled:=False;
Button3.Enabled:=False;
Button4.Enabled:=False;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SstretchRatioOnOff(Sender: TObject);
{set stretch Ratio mode}
begin
MultiImage1.Stretchratio:=CheckBox1.Checked;
CheckBox3.Checked:=False;
if (MultiImage1.Stretch) or (MultiImage1.StretchRatio) then begin
{Reset image sizes}
MultiImage1.AutoSize:=False;
MultiImage1.Height:=239;
MultiImage1.Width:=334;
ScrollBox1.ScrollInView(MultiImage1);
Button2.Enabled:=True;
Button3.Enabled:=True;
Button4.Enabled:=True;
end else begin
MultiImage1.AutoSize:=True;
Button2.Enabled:=False;
Button3.Enabled:=False;
Button4.Enabled:=False;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.FormCreate(Sender: TObject);
{what we do on create}
begin
Printersize:=TPrintersize.Create(Application);
{Define the callback procedure}
TPMultiImageCallBack:=ImageLibCallBack;
{set the value of the QualitySpin to the value of JPegSaveQuality}
QualitySpin.value:=MultiImage1.JPegSaveQuality;
{set the value of the Smoothspin to the value of JPegSaveSmooth}
Smoothspin.value:=MultiImage1.JPegSaveSmooth;
{create temporary history stringlists}
oldsavefiles := TstringList.create;
oldreadfiles := TstringList.create;
{IMPORTANT}
{This is the moving engine for all the messages. Since an application
can have only one OnIdle Trigger, this trigger needs to be subdivided
by all your moving and animated objects. In this particular case the
function is called TRIGGER but you can name it as you want as long
you have a procedure named the same.}
Application.OnIdle:=Trigger;
{Only enable this if delphi is active}
{$IFDEF DEL32}
LoadresourcefromDelphiExe1.Enabled:=(GetModuleHandle('DELPHI32.EXE') <> 0);
{$ELSE}
LoadresourcefromDelphiExe1.Enabled:=(GetModuleHandle('DELPHI.EXE') <> 0);
{$ENDIF}
SstretchOnOff(Sender);
end;
{---------------------------------------------------------------------}
Procedure TViewImageForm.Trigger(Sender : TObject; Var Done : Boolean);
begin
{This function is called when your app is idle. Subdivide the
trigger event to your TMultiImage objects who may need one.
If no Message is active it will not take up significant time}
MultiImage1.Trigger;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.resClick(Sender: TObject);
{Set the read resolution to either 16, 256 or true color in the vcl}
begin
{set show resolution to 1 bit monochrome black and white}
if Res1.checked then MultiImage1.ImageReadRes:=lMonoChrome;
{set show resolution to 4 bit 16 color using the system's colors}
if Res4System.checked then MultiImage1.ImageReadRes:=lColorVGA;
{set show resolution to 4 bit 16 color}
if res4.checked then MultiImage1.ImageReadRes:=lColor16;
{set show resolution to 8 bit 256 color}
if res8.checked then MultiImage1.ImageReadRes:=lColor256;
{set show resolution to 24 bit true color}
if res24.checked then MultiImage1.ImageReadRes:=lColorTrue;
{Let ImageLib determine the best resolution}
if resAuto.checked then MultiImage1.ImageReadRes:=lAutoMatic;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SaveResClick(Sender: TObject);
{Set the save resolution to either 16, 256 or true color in the vcl}
begin
{set Jpeg save resolution to GrayScale (Other formats will neglect
this parameter and set it to 8 bit}
if SaveResJpegGray.checked then MultiImage1.ImageWriteRes:=sJpegGray;
{set save resolution to 4 bit 16 color using the system's colors}
if SaveRes4System.checked then MultiImage1.ImageWriteRes:=sColorVGA;
{set save resolution to 4 bit 16 color}
if Saveres4.checked then MultiImage1.ImageWriteRes:=sColor16;
{set save resolution to 8 bit 256 color}
if Saveres8.checked then MultiImage1.ImageWriteRes:=sColor256;
{set save resolution to 24 bit true color}
if Saveres24.checked then MultiImage1.ImageWriteRes:=sColorTrue;
{Let ImageLib determine the best resolution}
if SaveResAuto.checked then MultiImage1.ImageWriteRes:=sAutoMatic;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SaveButtonClick(Sender: TObject);
{save a jpeg or bmp}
begin
{Set various filters}
if MultiImage1.BFileType = 'SCM' then begin
SaveDialog1.Filename:='*.SCM';
SaveDialog1.Filter:='Scroll message|*.scm';
end else
if MultiImage1.BFileType = 'CMS' then begin
SaveDialog1.Filename:='*.CMS';
SaveDialog1.Filter:='Credit message|*.cms';
end else begin
SaveDialog1.Filename:='*.jpg';
SaveDialog1.Filter:='jpeg|*.jpg|bmp|*.bmp|gif|*.gif|pcx|*.pcx|png|*.png|tif|*.tif';
end;
{open save dialog}
if SaveDialog1.execute then begin
{set hourglass cursor}
screen.cursor:=crHourGlass;
{save it if the extension is png}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.PNG' then
MultiImage1.SaveAsPNG(SaveDialog1.FileName);
{save it if the extension is pcx}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.PCX' then
MultiImage1.SaveAsPCX(SaveDialog1.FileName);
{save it if the extension is pcx}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.GIF' then
MultiImage1.SaveAsGIF(SaveDialog1.FileName);
{save it if the extension is jpg}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.JPG' then
MultiImage1.SaveAsJpg(SaveDialog1.FileName);
{save it if the extension is bmp}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.BMP' then
MultiImage1.SaveAsBMP(SaveDialog1.FileName);
{save it if the extension is SCM}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.SCM' then
MultiImage1.SaveCurrentMessage(SaveDialog1.FileName);
{save it if the extension is CMS}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.CMS' then
MultiImage1.SaveCurrentCreditMessage(SaveDialog1.FileName);
{save it if the extension is TIF}
if UpperCase(ExtractFileExt(SaveDialog1.Filename)) = '.TIF' then
MultiImage1.SaveAsTIF(SaveDialog1.FileName);
{add filename to the history list of the save dialog}
oldSavefiles.add(SaveDialog1.filename);
{copy the stringlist to the historylist}
SaveDialog1.historylist:=oldSavefiles;
{set default cursor}
screen.cursor:=crDefault;
{update the filelist box sothat the file saved shows up}
FileListBox1.Update;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.MultiImage1Click(Sender: TObject);
{show fullscreen}
begin
{copy image to fullscreen image}
FullSlide.MultiImage1.Picture.Graphic:=MultiImage1.Picture.Graphic;
{show the image fulscreen}
FullSlide.showmodal;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.E1Click(Sender: TObject);
{exit the program}
begin
close;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.O1Click(Sender: TObject);
{open a image using the open dialog}
begin
if OpenDialog1.execute then begin
SstretchOnOff(Sender);
{Reset image sizes}
MultiImage1.Height:=239;
MultiImage1.Width:=334;
{set hourglass cursor}
screen.cursor:=crHourGlass;
{delete the old image}
MultiImage1.imagename:='';
{display an image using the vcl}
MultiImage1.imagename:=OpenDialog1.filename;
{Request fileinfo from the DLL}
{Note, fileinfo will not work on WMF and ICO}
if GetInfoChecked.Checked then
DisplayInfo(true) else DisplayInfo(false);
{reset the gauge}
Gauge1.Progress:=0;
{add filename to the history list of the open dialog}
oldreadfiles.add(OpenDialog1.filename);
{copy the stringlist to the historylist}
OpenDialog1.historylist:=oldreadfiles;
{set default cursor}
screen.cursor:=crDefault;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.A1Click(Sender: TObject);
{about box}
begin
{Copy the image to the image of he about box}
AboutBox.Image1.Picture.Graphic:=MultiImage1.Picture.Graphic;
{show the about box}
AboutBox.showmodal;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Print1Click(Sender: TObject);
{Print image}
begin
if PrintDialog1.execute then begin
{Initialize the height spinedit of the printsize dialog box}
Printersize.HeigthSpinEdit.Value:=MultiImage1.Picture.Height;
{Initialize the width spinedit of the printsize dialog box}
Printersize.WidthSpinEdit.Value:=MultiImage1.Picture.Width;
{Show it}
Printersize.ShowModal;
if Printersize.Modalresult = mrok then
{print TMultiImage}
MultiImage1.PrintMultiImage(0,0,Printersize.WidthSpinEdit.Value,Printersize.HeigthSpinEdit.Value);
{Hide it if done}
Printersize.hide;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.PrintSetup1Click(Sender: TObject);
{Set up printer}
begin
PrinterSetupDialog1.Execute;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.GetInfoCheckedClick(Sender: TObject);
{depending on the state of the checkbox, display or not display info}
begin
DisPlayInfo(GetInfoChecked.Checked);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn1Click(Sender: TObject);
var
RunAfterCreate : Boolean;
begin
{Create a new message using the message editor}
{boolean indicating to run the message after creation}
RunAfterCreate:=True;
{CreateMessage takes a pathname as the initial path to save the
message and a boolean to run it. For Instance:
{MultiImage1.CreateMessage('c:\',true);}
MultiImage1.CreateMessage(ExtractFilePath(Application.Exename),RunAfterCreate);
{Show new message in listbox}
FileListBox1.Update;
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure TViewImageForm.Cut1Click(Sender: TObject);
begin
{Cut Image and Copy it to the clipboard}
MultiImage1.CutToClipboard
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Copy1Click(Sender: TObject);
begin
{Copy Image to the clipboard}
MultiImage1.CopyToClipboard;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Paste1Click(Sender: TObject);
begin
{Paste Image from the clipboard}
MultiImage1.PasteFromClipboard;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.ScrollBar1Change(Sender: TObject);
begin
{Change the speed of a srolling message}
MultiImage1.MsgSpeed:=ScrollBar1.Position;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SmoothspinChange(Sender: TObject);
begin
{set the value of the JPegSaveSmooth}
MultiImage1.JPegSaveSmooth:=Smoothspin.value;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.QualitySpinChange(Sender: TObject);
begin
{set the value of the JPegSaveQuality}
MultiImage1.JPegSaveQuality:=QualitySpin.value;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.CheckBox2Click(Sender: TObject);
begin
{Set read image dither }
MultiImage1.ImageDither:=CheckBox2.Checked;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn2Click(Sender: TObject);
var
RunAfterCreate : Boolean;
begin
{Create a new message using the message editor}
{boolean indicating to run the message after creation}
RunAfterCreate:=True;
{CreateCreditMessage takes a pathname as the initial path to save the
message and a boolean to run it. For Instance:
{MultiImage1.CreateCreditMessage('c:\',true);}
MultiImage1.CreateCreditMessage(ExtractFilePath(Application.Exename),RunAfterCreate);
{Show new message in listbox}
FileListBox1.Update;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn5Click(Sender: TObject);
{Load a BMP image from any executable or dll.
Note that the dll or exe needs to be loaded in order
to find its module handle}
begin
{Indicate in which program the BMP Lives. For instance:
MultiImage1.ResProgName:='';
means in this executable (RES (Resource file))}
{Dont enter a path name};
MultiImage1.ResProgName:=''; {this executable linked in BLIT8.RES}
{Name of the resource. Note that the .res indicate to the vcl
that it is a resource BMP but your resource BMP is called FRIDGE.
Incase the resource is a number put e.g: MultiImage1.ImageName:='98255.RES';}
MultiImage1.ImageName:='FRIDGE.RES';
if GetInfoChecked.Checked then
DisplayInfo(true) else DisplayInfo(false);
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn6Click(Sender: TObject);
begin
{Indicate in which program the BMP Lives. For instance:
MultiImage1.ResProgName:='';
means in this executable (RES (Resource file))}
{Dont enter a path name};
{$IFDEF DEL32}
MultiImage1.ResProgName:='DELPHI32.EXE';
{$ELSE}
MultiImage1.ResProgName:='DELPHI.EXE';
{$ENDIF}
{Name of the resource. Note that the .res indicate to the vcl
that it is a resource BMP but your resource BMP is called FRIDGE.
Incase the resource is a number put e.g: MultiImage1.ImageName:='98255.RES';}
MultiImage1.ImageName:='ATHENA.RES';
if GetInfoChecked.Checked then
DisplayInfo(true) else DisplayInfo(false);
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn3Click(Sender: TObject);
begin
{Create A credit message on the fly}
MultiImage1.FreeMsg;
{Clear Message text if any}
MultiImage1.CreditBoxList.Clear;
{Define Message text}
MultiImage1.CreditBoxList.Add(' ImageLib');
MultiImage1.CreditBoxList.Add(' Another fine product of');
MultiImage1.CreditBoxList.Add(' SKYLINE TOOLS');
MultiImage1.CreditBoxList.Add(' Programming : Kevin Adams');
MultiImage1.CreditBoxList.Add(' Programming : Jan Dekkers');
MultiImage1.CreditBoxList.Add(' Artwork & PR: Jillian Pinsker');
MultiImage1.CreditBoxList.Add(' Management: Chris Giggey');
{set Message font name; Note you could do this also with a font dialog}
MultiImage1.MsgFont.Name:='Arial';
{set Message font size}
MultiImage1.MsgFont.Size:=-18;
{set Message font style}
MultiImage1.MsgFont.Style:=[fsitalic, fsbold];
{set Message font color}
MultiImage1.MsgFont.Color:=clWhite;
{set Message background. Note you could do this also with a color dialog}
MultiImage1.MsgBkGrnd:=clNavy;
{set Message speed from 1 is fast to 10 is slow}
MultiImage1.MsgSpeed:=5;
{Show Speed ScrollBar}
ScrollBar1.Visible:=true;
{set the speed/position}
ScrollBar1.Position:=MultiImage1.MsgSpeed;
{inititiate new message}
MultiImage1.NewCreditMessage;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn4Click(Sender: TObject);
begin
{create a message on the fly at MultiImage1 (Top one)}
{set Message text}
MultiImage1.MsgText:='ImageLib 3.1 A great tool to create a superb application in no time.';
{set Message font name; Note you could do this also with a font dialog}
MultiImage1.MsgFont.Name:='Arial';
{set Message font size}
MultiImage1.MsgFont.Size:=-40;
{set Message font style}
MultiImage1.MsgFont.Style:=[fsitalic, fsbold];
{set Message font color}
MultiImage1.MsgFont.Color:=clYellow;
{set Message background. Note you could do this also with a color dialog}
MultiImage1.MsgBkGrnd:=clPurple;
{set Message speed from 1 is fast to 10 is slow}
MultiImage1.MsgSpeed:=3;
{Show Speed ScrollBar}
ScrollBar1.Visible:=true;
{set the speed/position}
ScrollBar1.Position:=MultiImage1.MsgSpeed;
{inititiate new message}
MultiImage1.NewMessage;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.CheckBox4Click(Sender: TObject);
begin
{Use the ImageLib way of drawing. This is a 256 color problem
workaround caused by some VGA driver in delphi}
MultiImage1.ImageLibPalette:=CheckBox4.Checked;
MultiImage1.Invalidate;
{in case ImageLibPalette is not set uncheck strectch ratio}
if CheckBox1.Checked and not CheckBox4.Checked then
CheckBox1.Checked:=False;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.BitBtn7Click(Sender: TObject);
begin
{Text on an Image}
MultiImage1.Text:=(Edit10.Text);
{Text can be shadowed}
MultiImage1.TextShadow:=True;
{Text position}
MultiImage1.TextLeft:=1;
{Text position}
MultiImage1.TextTop:=MultiImage1.ClientRect.Top;
{Text angle in degrees}
MultiImage1.TextRotate:=0;
{Text background color}
MultiImage1.TextTransParent:=True;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.MultiImage1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{The begin points of zooming/flipping or rotating}
bRightDown := false;
if button = mbRight then begin
MultiImage1.ResetImage;
bRightDown := true;
pointStart.X := X;
pointStart.Y := Y;
pointEnd.X := X;
pointEnd.Y := Y;
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.MultiImage1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not bRightDown then exit;
if Button = mbRight then begin
DrawRubberband;
bRightDown := false;
pointEnd.X := X;
pointEnd.Y := Y;
{Zoom , flip or rotate image}
MultiImage1.TransformImage(Rect(pointStart.X, pointStart.Y, pointEnd.X, pointEnd.Y));
end;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.MultiImage1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if not bRightDown then exit;
DrawRubberband;
pointEnd.x := X;
pointEnd.y := Y;
DrawRubberband;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.DrawRubberband;
begin
SetROP2(MultiImage1.Canvas.handle, R2_NOT);
MultiImage1.Canvas.moveto(pointStart.x, pointStart.y);
MultiImage1.Canvas.lineto(pointStart.x, pointEnd.y);
MultiImage1.Canvas.lineto(pointEnd.x, pointEnd.y);
MultiImage1.Canvas.lineto(pointEnd.x, pointStart.y);
MultiImage1.Canvas.lineto(pointStart.x, pointStart.y);
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Button3Click(Sender: TObject);
begin
{Flip the image}
MultiImage1.FlipImage;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Button2Click(Sender: TObject);
begin
{Rotate the image}
MultiImage1.RotateImage;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Button4Click(Sender: TObject);
begin
{Reset the image to its original size/position}
MultiImage1.ResetImage;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.TiffComboChange(Sender: TObject);
begin
{Set the compression method to save tiffs}
if TiffCombo.Text ='NONE' then
MultiImage1.TifSaveCompress:=sNONE;
if TiffCombo.Text ='CCITT' then
MultiImage1.TifSaveCompress:=sCCITT;
if TiffCombo.Text ='LZW' then
MultiImage1.TifSaveCompress:=sLZW;
if TiffCombo.Text ='PACKBITS' then
MultiImage1.TifSaveCompress:=sPACKBITS;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.Scan1Click(Sender: TObject);
begin
{Scan an image using a twain scanner}
MultiImage1.ScanImage(Handle);
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.SelectScanner1Click(Sender: TObject);
begin
{Select a twain scanner source}
MultiImage1.SelectScanner(Handle);
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Application.OnIdle:=Nil;
{Unregister the callback procedure}
TPMultiImageCallBack:=nil;
{release memory of the stringlist boxes}
oldsavefiles.free;
oldreadfiles.free;
ViewImageForm:=Nil;
Action:=caFree;
end;
{---------------------------------------------------------------------}
procedure TViewImageForm.OpenUsingThumbnails1Click(Sender: TObject);
begin
ThumbPreview1.PreviewsDir:='d:\';
ThumbPreview1.DataFileDir:='d:\';
If ThumbPreview1.Execute then begin
SstretchOnOff(Sender);
{Reset image sizes}
MultiImage1.Height:=239;
MultiImage1.Width:=334;
{set hourglass cursor}
screen.cursor:=crHourGlass;
{delete the old image}
MultiImage1.imagename:='';
{display an image using the vcl}
MultiImage1.imagename:=ThumbPreview1.filename;
{Request fileinfo from the DLL}
{Note, fileinfo will not work on WMF and ICO}
if GetInfoChecked.Checked then
DisplayInfo(true) else DisplayInfo(false);
{reset the gauge}
Gauge1.Progress:=0;
{add filename to the history list of the open dialog}
oldreadfiles.add(OpenDialog1.filename);
{copy the stringlist to the historylist}
OpenDialog1.historylist:=oldreadfiles;
{set default cursor}
screen.cursor:=crDefault;
end;
end;
end.